home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Mops 2.7 / Mops source / System source / Frontend < prev    next >
Encoding:
Text File  |  1995-08-09  |  6.9 KB  |  315 lines  |  [TEXT/MSET]
  1. \ Front end for Mops.
  2.  
  3. \ EVENTLOOP is a word you can use in installed applications, or during
  4. \ testing if you have other windows up besides fWind.  If one of the
  5. \ other windows is in front, typed keys are sent to it via KEY:.  If
  6. \ fWind is in front, typed keys are interpreted.  Your other windows
  7. \ will need an Activate handler which calls EventLoop.
  8.  
  9. : EVENTLOOP            \ 30Apr94 DBH, incredibly simple
  10.     BEGIN
  11.         next: fevent        \ next: no longer returns a boolean
  12.     AGAIN ;
  13.  
  14.  
  15. \ Some objects needed by QE and TEfwindMod
  16.  
  17.         handle    QEhand        \ a place for the handle passed in from Quick Edit
  18.         string+    QEstr
  19. false    value    ClrStk?        \ true if we're to clear stack on next idle
  20.                             \  or update
  21.  
  22. ' drop    vect    .CELL
  23.  
  24. : (.CELL)      \ ( adr -- )
  25.     @ .  ;
  26.  
  27. ' (.cell) -> .cell            \ This is enhanced when FP loaded
  28.  
  29.  
  30. window    DW                    \ For display of source text during debugging
  31.  
  32. forward  setTW
  33.  
  34. from EXTRASMOD 
  35.     IMPORT{    l rl cl fm need +log -log  (create_log)  (write_log)
  36.             locate_src addr>curs move_curs ?open_in_QE
  37.             edit  openSource  def??
  38.             redraw  use_module
  39.             1up 1dn 1lft 1rt  homex end  defnup defndn selectdw
  40.             prof_str  }
  41.  
  42. : LOCATE    openSource  ;        \ a better name, I think
  43.  
  44. :f CREATE_LOG    (create_log)  ;f
  45. :f WRITE_LOG    (write_log)   ;f
  46.  
  47. compile: extrasMod
  48.  
  49. ' null    vect    ABOUTVEC    \ So AppleMen can be reused as is by
  50.                             \  applications.
  51.                             
  52. ' bye    vect    BYEVEC        \ Our new TE interface needs to do some extra things
  53.  
  54.  
  55. \ Define the menus for the Mops menu bar:
  56.  
  57. 2    AppleMenu    APPLEMEN
  58. 6    menu        FILEMEN
  59. 9    EditMenu    EDITMEN
  60. 3    menu        LISTMEN
  61. 3    menu        SHOWMEN
  62. 6    menu        UTILMEN
  63.  
  64.  
  65. \ PowerPC assembler:
  66.  
  67. from pasmMod import{    :PPC_code  ;PPC_code
  68.                         disasm  disasm_word  disasm_xt
  69.                         disasm_rng  disasm_cnt  disasm_one
  70.                         set_disasm_call_range  }
  71.  
  72. compile: pasmMod
  73.  
  74.  
  75. \ Support code for our TEwind interface:
  76.  
  77. string+ TWstr
  78.  
  79. forward  NEWVECS
  80. forward  OLDVECS
  81.  
  82. false    value    PROMPT?
  83.  
  84. forward  run_TE
  85. forward  .room
  86. forward     doPref
  87. forward  nimpl
  88. forward  flush_TWstr
  89.  
  90.  
  91. from TEFwindMod import{  do_run_TE  TEFwind  bye+  evalFromQE
  92.                         xUndo xCut xCopy xPaste xClear xSelAll }
  93.  
  94. from  FEMOD    import{  (about) save
  95.                     enFW disFW save stdSave doSave
  96.                     doUndo doCut doCopy doPaste doClear doSelAll xPref
  97.                     doOlist  doClist  x.room xNimpl
  98.                     Lecho  doPurge
  99.                     get_appl_name get_appl_vers get_appl_sig
  100.                     set_appl_name set_appl_vers set_appl_sig
  101.                     run_FE  }
  102.  
  103. :f .room    x.room    ;f
  104. :f doPref    xPref   ;f
  105. :f nimpl    xNimpl  ;f
  106.  
  107. compile: FEmod
  108. compile: TEFwindMod
  109. lock: TEFwindMod
  110.  
  111. TEFwind      TW
  112.  
  113.     screenbits    true  setGrow: tw
  114.                 true  setZoom: tw
  115.  
  116.  
  117. : TWPORT?        \ The vecs only need to be different if TW is the grafport
  118.     savePort  thePort @  addr: tw  = ;
  119.  
  120. : ERR_SRC
  121.     topFile nilP <>
  122.     IF      \ We try to open the source in QE.  We don't use LOCATE_SRC
  123.             \  since here we only want a source display if it's QE.
  124.         topFile ?open_in_QE
  125.         pos: topFile  move_curs
  126.     THEN
  127.     TWport?
  128.     IF        -echo   0 -> (err#)        \ Clear error indicator from AppleEvents
  129.             dflt-err                \ Display error info and abort
  130.     ELSE    (ddie)
  131.     THEN  ;
  132.  
  133. ' err_src  -> dflt-die
  134.  
  135. :f FLUSH_TWstr
  136.     pos: TWstr  0EXIT
  137.     lock: TWstr
  138.     all: TWstr insert: TW
  139.     unlock: TWstr
  140.     clear: TWstr  ;f
  141.  
  142.  
  143. : XEMIT        \ ( char -- )
  144.     TWport?
  145.     IF        +: TWstr
  146.     ELSE    (emit)
  147.     THEN  ;
  148.  
  149. : XCR
  150.     TWport?    
  151.     IF        RET xemit  flush_TWstr
  152.     ELSE    (cr)
  153.     THEN  ;
  154.  
  155. : XTYP        \ ( addr len -- )
  156.     TWport?
  157.     IF        add: TWstr
  158.     ELSE    (type)
  159.     THEN  ;
  160.  
  161. : XSPS        \ Replacement for SPACES
  162.     TWport?
  163.     IF        dup 0<= IF  drop  EXIT  THEN
  164.             pad swap 2dup bl fill
  165.             add: TWstr
  166.     ELSE    (spaces)
  167.     THEN  ;
  168.  
  169. : XQUIT
  170.     RP0  RP!  eventloop  ;        \ QUIT will now always come back to EventLoop
  171.  
  172.  
  173. :f NEWVECS
  174.     ['] xemit    -> emitvec
  175.     ['] xcr        -> crvec
  176.     ['] xtyp    -> typevec
  177.     ['] xsps     -> spvec
  178.     ['] xemit     -> echovec
  179.     ['] setTW    -> setfWind 
  180.     ['] xquit    -> quitvec
  181.     ['] bye+    -> byevec
  182. ;f
  183.  
  184. :f OLDVECS
  185.     ['] (emit)        -> emitvec
  186.     ['] (cr)        -> crvec
  187.     ['] (type)        -> typevec
  188.     ['] (spaces)    -> spvec
  189.     ['] (emit)        -> echovec
  190.     ['] (sf)        -> setfWind
  191. \    0                -> quitvec        \ mh May94 - quit doesn't get changed any more
  192.     ['] bye            -> byevec
  193. ;f
  194.  
  195.  
  196. :f RUN_TE
  197.     load: TEFwindMod  lock: TEFwindMod        \ May have been purged
  198.     new: TWstr     \ 31Jan94 DBH
  199.     TW  do_run_TE
  200. ;f
  201.  
  202. :f setTW        select: TW  set: TW  enable: TW  ;f
  203.  
  204.  
  205.  
  206. \        ================= start of QE-related code ===================
  207.  
  208. \ The following words are called from QE, by QE sending us a string to
  209. \ EVALUATE.
  210.  
  211. \ StackClear clears the stack - we don't do the actual clear straight away,
  212. \ since the Mops system might have a variable number of cells in use.
  213. \ Instead we set clrStk? true, so that we'll handle it when our window TW
  214. \ gets idle: or update:, when things are consistent.
  215.  
  216. : STACKCLEAR
  217.     true -> clrStk?  ;
  218.  
  219.  
  220. \ ClrWind is used by the QE and Mops menu item "Clear Window".
  221.  
  222. : ClrWind
  223.     fWind?
  224.     IF      cls
  225.     ELSE    selAll: TW  clear: TW
  226.             actW TW <>        \ this seems to be necessary if TW isn't frontmost
  227.             IF    getRect: TW  put: tempRect  clear: tempRect  THEN
  228.     THEN  ;
  229.  
  230.  
  231. \ Now we have the words which support high-level events from Quick Edit.
  232. \ (Note these aren't AppleEvents.)
  233. \ Thanks to Doug Hoffman for these.
  234.  
  235.  
  236. : DoHLevent     \ ( -- b )
  237.     msgClass: fEvent  'type TEXT  =  \ a simple check for proper class
  238.     IF
  239.         msgID: fEvent  put: QEhand  \ message ID is merely the handle from QE
  240.         ptr: QEhand  size: QEhand  put: QEstr
  241.         evalFromQE  fWind? NIF  update: TW cr THEN     \ 01Feb94 DBH  Need the cr to insert: tw
  242.         true            \ we did handle the event
  243.     ELSE
  244.         false            \ we did not handle the event
  245.     THEN
  246.     ;
  247.  
  248. : InitQE
  249.     instld?  ?EXIT            \ Mustn't do this in installed apps
  250.     true -> resume?
  251.     ['] DoHLevent -> HLeventVec
  252.     new: QEstr
  253.     ;
  254.  
  255. ' InitQE add: init_actions
  256.  
  257.  
  258. \        =========== End of QE-related code ==================
  259.  
  260.  
  261.     0    value    TEMPA5        \ Used by DebugMod while we're getting
  262.                             \  addressable.  Must be in main dic.
  263.     0    value    LAST_TIME    \ These 3 are used by DebugMod when profiling.
  264.     0    value    NOW
  265.     0    value    THIS_BP
  266.  
  267. from DEBUGMOD    import{  in notin (see) see debug unbug resume show
  268.              profile  showp  }
  269.  
  270. from INSTLMOD    import{  install  }
  271.  
  272. from  UTILMOD    import{  .mods  .msgs  addmsg  removemsg  getindstr  }
  273.  
  274. from ALERTQMOD    import{  (al)  }
  275.  
  276. xts{  aboutVec  doDsk  }                    1  init: appleMen
  277.  
  278. xts{  L null doSave stdSave null byevec  }    2  init: FileMen
  279.  
  280. \ xts{  doUndo null doCut doCopy doPaste doClear doSelAll null xPref  }
  281. \                                                        3  init: EditMen
  282.  
  283. xts{  words doOlist doClist  }                4  init: ListMen
  284.  
  285. xts{  .paths  .room  .mods  }                5  init: ShowMen
  286.  
  287. xts{  LEcho stackClear ClrWind  null install doPurge  }
  288.                                             6  init: UtilMen
  289.  
  290.  
  291. : RUN        \ System startup word for the Mops development environment.
  292.     sysinit  run_FE  ;
  293.  
  294. ' run     -> objinit
  295.  
  296. 20 -> sleepticks            \ Default value - allows a time display
  297.                             \ to be updated reasonably.
  298.  
  299. false -> fwind?                \ Default is our new TE window.  This will now
  300.                             \  be permanent for the Mops development
  301.                             \  environment.
  302.  
  303. compile: FEmod
  304. compile: utilmod
  305. compile: debugmod
  306. compile: instlmod
  307.  
  308.  
  309. cr cr cr
  310. .( The Mops system is compiled.  Now save the dictionary, by typing e.g.) cr
  311. .( save Mops.dic) cr
  312. .( then type bye to quit, and after that you'll be able to fire up the) cr
  313. .( newly-compiled dictionary.)  cr cr
  314.  
  315.